home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Questions & Answers / Q&A Programming Functions / More permutations < prev    next >
Encoding:
Text File  |  1998-10-26  |  1.8 KB  |  48 lines  |  [TEXT/ScoM]
  1. MORE PERMUTATIONS
  2.  
  3. >- Is there a function that will take a symbol patter (say '(a b c d)) and
  4. >produce all possible permutations of it (including ones not obtainable via
  5. >symbol-scroll such as '(a c d b))?
  6.  
  7. It's on the MRAC, but since I have also written that function I can
  8. send it to you. Here it comes, copy the code into a file and save it
  9. in SCOM 4.0/Environment/Extensions folder. All files there will be loaded
  10. at startup time. Use flatten to get rid of sublists if you need.
  11.  
  12. ; gen-permutation
  13.  
  14. #|  
  15. (gen-permutation '(a b c d))
  16. --> ((a b c d) (a b d c) (a c b d) (a c d b) (a d b c) (a d c b) (b a c d) (b a d c) (b c a d) (b c d a) (b d a c) (b d c a) (c a b d) (c a d b) (c b a d) (c b d a) (c d a b) (c d b a) (d a b c) (d a c b) (d b a c) (d b c a) (d c a b) (d c b a))
  17. (flatten (gen-permutation '(a b c d)))
  18. --> (a b c d a b d c a c b d a c d b a d b c a d c b b a c d b a d c b c a d b c d a b d a c b d c a c a b d c a d b c b a d c b d a c d a b c d b a d a b c d a c b d b a c d b c a d c a b d c b a)
  19.  
  20. |#
  21.  
  22. (defun gen-permutation (l)
  23.   (delete-duplicates (gen-permutation-sup l) :test #'equal))
  24.  
  25. (defun gen-permutation-sup (list-to-permute)
  26.   (if (null (cdr list-to-permute))
  27.     (list list-to-permute)
  28.     (mapcan
  29.      #'(lambda (x)
  30.          (map 'list #'(lambda (y) (cons x y))
  31.               (gen-permutation-sup (remove-first x list-to-permute))))
  32.      list-to-permute)))
  33.  
  34. (defun remove-first (item l)
  35.   (let ((out nil) (removed nil))
  36.     (dolist (x l)
  37.       (if (or removed (not (equal x item)))
  38.         (push x out)
  39.         (setq removed t)))
  40.     (nreverse out)))
  41.  
  42. >Thanks very much--and if I survive this my music won't (at least in the
  43. >form it has been before).
  44.  
  45. Ping! Just few lines code like in the above makes it permute, think
  46. about that ;-). BTW permutation time increases rapidly when there are more 
  47. terms.
  48.